perm filename EDIT.FAI[RST,LCS] blob sn#209689 filedate 1976-04-02 generic text, type T, neo UTF8
00100		TITLE EDIT
00200		ENTRY EDIT
00300	EDIT:	0		;	00100	      SUBROUTINE EDIT(JJA)
00400	;		00200	      COMMON/ALF/INP(72),ML /UPDWN/ RL,UD
00500	;		00300	      COMMON /SC/JL,LJ,MK
00600	;00400	     1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JM,JN,DBST,NFLG,IXX,ISEMI,QQ
00700	;		00500	     1 ,RVX(50),IAMP,A,RRN,B,MODE,IBLA
00800	;		00600	      COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00900	;		00700	      COMMON/RRJJ/RJJ2,RJJ(20)
01000	;00800	      EQUIVALENCE (RVX1,RVX(1)),(RVX2,RVX(2)),(RVX4,RVX(4))
01100	;00900	     1,(RVX3,RVX(3)),(RJ6,RJJ(4)),(RJ9,RJJ(7)),(R3,RJQ(1))
01200	;01000	     1,(RJ5,RJJ(3)),(RJ10,RJJ(8)),(INP2,INP(2)),(INP20,INP(20))
01300		DEFINE JN<SC+=10> ↔ DEFINE ML <ALF+=72> ↔ DEFINE JA <.COMM.+1>
01400		DEFINE R2<.COMM.> ↔ DEFINE RJJ2<RRJJ>  ↔ DEFINE UD <UPDWN+1>
01500		DEFINE RVX1<SC+=16> ↔ DEFINE RVX2<SC+=17> ↔ DEFINE RVX3<SC+=17>
01600		DEFINE RVX4<SC+=18> ↔ DEFINE RJ6<RRJJ+4> ↔ DEFINE RJ5<RRJJ+3>
01700		DEFINE RJ9<RRJJ+=7> ↔ DEFINE RJ10<RRJJ+=8> ↔ DEFINE R3<.COMM.+4>
01800		DEFINE INP2<ALF+1> ↔ DEFINE INP20<ALF+=19> ↔ DEFINE ISEMI<SC+=14>
01900		DEFINE RL<UPDWN> ↔ DEFINE RJJ <RRJJ+1>
02100		EXTERNAL .COMM.,ALF,RRJJ,SC,LPEN,MVBEAM,IFIX,SCANR,UPDWN
02200	;		01100	      JN=-1
02300	      	SETOM 	JN    
02400		MOVE @(16)
02500		MOVEM JJA#
02600	;		01200	C  THIS IS FLAG IN SCANR
02700	;		01300	      INP20=ISEMI
02800	      	MOVE  	02,ISEMI 
02900	      	MOVEM 	02,INP20 
03000	;		01400	C  SETS LIMIT IN SCANR
03100	;		01500	      ML=1
03200	      	MOVEI 	02,1
03300	      	MOVEM 	02,ML    
03400	;		01600	      RVX2=0
03500	      	SETZM 	RVX2  
03600	;		01700	      RVX4=0
03700	      	SETZM 	RVX4  
03800	;01800	C E=EDIT(55), C=COPY(2222), X=EXIT(222), DE=DEL(99), LP=LTPN
03900	;		01900	      CALL SCANR
04000	      	JSA   	16,SCANR 
04100	;		02000	      JN=0
04200	      	SETZM 	JN    
04300	;		02100	      R2=RVX2
04400	      	MOVE  	3,RVX2  
04500	      	MOVEM 	3,R2    
04600	;		02200	      IF(RVX1.GT.10.)GO TO 7
04700	      	MOVSI 	02,204500
04800	      	CAMGE 	02,RVX1  
04900	      	JRST  	E7    
05000	;		02300	      JA=0
05100	      	SETZM 	JA    
05150		SETZ 0,		; FOR E8
05200	;		02400	      IF(RVX2.NE.0)GO TO 8
05400	      	JUMPN 	3,E8    
05500	;		02500	      IF(INP2.EQ.'P')GO TO 5
05600	      	MOVE  	02,[501004020100]
05700	      	CAMN  	02,INP2  
05800	      	JRST  	E5    
05900	;		02600	      RVX2=RL
06000	      	MOVE  	02,RL    
06200	;		02700	      IF(RVX1.GT.2)RVX2=UD
06300	      	MOVSI 	202400
06400	      	CAMGE 	RVX1  
06600	      	MOVE  	02,UD    
06700	      	MOVEM 	02,RVX2  
06900	;		02800	C  STORES RT-LFT OR UP-DOWN INFO
07000	;		02900	      GO TO 8
07100	      	JRST  	E8    
07200	;		03200	C   FOR LIGHT PEN MOVING
07300	;		03300	7     JA=RVX1
07400	E7:   	JSA   	16,IFIX  
07500	      	JUMP   	00,RVX1  
07600	      	MOVEM 	00,JA    
07700		CAIN =99	;03400	      IF(JA.EQ.99)R2=0
08100	      	SETZM 	R2    
08300	;		03500	      IF(R2.NE.0)RETURN
08400	      	SKIPE    R2    
08600		JRA 16,1(16)
08800		CAIE =55	;03600	      IF(JA.NE.55)RETURN
09100		JRA 16,1(16)
09400	;		03700	5     CALL LPEN(R3,R2,K)
09500	E5:   	JSA   	16,LPEN  
09600	      	JUMP   	R3    
09700	      	JUMP   	R2    
09800	      	JUMP   	00,K#
09900	;		03800	C  ↑↑↑ K NOT USED!
10000	;03900  CURSOR WILL FIND HORZ POS FOR 55 EDIT.(R3=STF,R2=HORZ) SEE 554 IN MAIN.
10100	;		04000	      IF(JA.EQ.0)CALL EXCH(R2,R3)
10200	      	MOVE  	02,JA    
10300	      	JUMPN 	02,.+4   
10400		MOVE R2
10500		EXCH R3
10600		MOVEM R2
10800	;		04100	      RVX1=2.
10900	      	MOVSI 	02,202400
11000	      	MOVEM 	02,RVX1  
11100	;		04200	      RVX2=R3-RJJ(1)
11200	      	MOVE  	02,R3    
11300	      	FSBR  	02,RJJ   
11400	      	MOVEM 	02,RVX2  
11500	;		04300	      RVX3=3.
11600	      	MOVSI 	02,202600
11700	      	MOVEM 	02,RVX3  
11800	;		04400	      RJQ(2)=0
11900	      	SETZM 	.COMM.+5	; R4
12000	;		04500	      RJJ2=R2
12100	      	MOVE  	02,R2    
12200	      	MOVEM 	02,RJJ2  
12300	;		04700	C  SO JD WILL BE 0 IN MAIN PROG.
12400	;		04800	C  FOR EDIT MODE
12500	E8:	CAIN =55	;	04900	8     IF(JA.EQ.55)RETURN
12800		JRA 16,1(16)
13100	;		05000	      IF(INP2.EQ.'P')GO TO 17
13200	      	MOVE  	02,[501004020100]
13300	      	CAMN  	02,INP2  
13400	      	JRST  	E17   
13500	;		05100	      IF(RVX1.GT.2)GO TO 117
13600	      	MOVSI 	02,202400
13700	      	CAMGE 	02,RVX1  
13800	      	JRST  	E117  
13900	;		05200	      RL=RVX2
14000	      	MOVE  	02,RVX2  
14100	      	MOVEM 	02,RL    
14200		SKIPE 2,RVX4	    ;	05300	      IF(RVX4.NE.0)UD=RVX4
14600	      	MOVEM 	02,UD    
14800	;		05400	      GO TO 17
14900	      	JRST  	E17   
15000	;		05500	117   IF(RVX4.NE.0)RL=RVX4
15100	E117: 	MOVE  	02,RVX4  
15200	      	JUMPE 	02,.+3   
15300	      	MOVE  	02,RVX4  
15400	      	MOVEM 	02,RL    
15600	;		05600	      UD=RVX2
15700	      	MOVE  	02,RVX2  
15800	      	MOVEM 	02,UD    
15900	;		05700	17    R2=.00001
16000	E17:  	MOVE  	02,[0.00001]
16100	      	MOVEM 	02,R2    
16200	;		05800	      JA=0
16300	      	SETZM 	JA    
16400	;		05900	      K=RVX1
16500	      	JSA   	16,IFIX  
16600	      	JUMP   	00,RVX1  
16700	      	MOVEM 	00,K     
16800	;		06000	857   GO TO (1,2,3,4,2),K
16900	E857: 	SKIPLE	01,K     
17000	      	CAILE 	01,5
17100	      	SKIPA 	0
17200	EE11:  	JRST  	@EE11   (1)
17300	      	JUMP   	00,E1    
17400	      	JUMP   	00,E2    
17500	      	JUMP   	00,E3    
17600	      	JUMP   	00,E4    
17700	      	JUMP   	00,E2    
17800	;		06100	4     RVX2=-RVX2
17900	E4:   	MOVNS 	00,RVX2  
18000	;		06300	C  SKIP OVER CLEFS (JJA=3) IS NOW REMOVED. 6/73
18100	;		06400	3     CALL MVBEAM(RJJ,0,2,2,RVX2)
18200	E3:   	JSA   	16,MVBEAM
18300	      	JUMP   	RJJ   
18400	      	JUMP   	[0]
18500	      	JUMP   	[2]
18600	      	JUMP   	[2]
18700	      	JUMP   	RVX2  
18800	;		06500	C  MOVES UP AND DOWN.  HANDLES MINIS, ETC.
18900		MOVE JJA    ;	06600	      IF(JJA.LT.4)GO TO 856
19100	      	CAIGE 4  
19200	      	JRST  	E856  
19300		CAILE 6    ;	06700	      IF(JJA.GT.6)GO TO 856
19600	      	JRST  	E856  
19700	;		06800	C   I THINK R2 MUST BE NON-ZERO TO WORK IN EDIT MODE?
19800	;		06900	12    IF(RJ5.EQ.50)GO TO 856
19900	   	MOVSI 	02,206620
20000	      	CAMN  	02,RJ5   
20100	      	JRST  	E856  
20200	;		07000	C   50=CRESC.-DECRESC.
20300	;		07300	      RJ5=RJ5+RVX2
20400	      	MOVE  	02,RVX2  
20500	      	FADRM 	02,RJ5   
20600	;		07400	C  MOVES 5TH PARAM UP OR DOWN
20700		JRST E856   ;	07500	      GO TO 856
20800	;		07600	1     RVX2=-RVX2
20900	E1:   	MOVNS 	00,RVX2  
21000	;		07700	2     R2=RVX2
21100	E2:   	MOVE  	02,RVX2  
21200	      	MOVEM 	02,R2    
21300	;		07800	856   IF(RVX4.EQ.0)GO TO 858
21400	E856: 	MOVE  	3,RVX4  
21500	      	JUMPE 	3,E858  
21600	;		07900	      K=RVX3
21700	      	JSA   	16,IFIX  
21800	      	JUMP   	00,RVX3  
21900	      	MOVEM 	00,K     
22000	;		08000	      RVX2=RVX4
22200	      	MOVEM 	3,RVX2  
22300	;		08100	      RVX4=0
22400	      	SETZM 	RVX4  
22500	;		08200	      GO TO 857
22600	      	JRST  	E857  
22700	;		08300	858   IF(R2.EQ..00001)GO TO 7515
22800	E858: 	MOVE  	1,R2
22900	      	CAMN 1,[0.00001] 
23000	      	JRST  	E7515 		;  1 HAS R2
23100		MOVE JJA    ;	08400	      IF(JJA.LT.5)GO TO 477
23300		CAIGE 5
23400	      	JRST  	E477  
23500		CAIG =8    ;	08500	      IF(JJA.LE.8)GO TO 5515
23800	      	JRST  	E5515 
23900	E477:	CAIE 4    ;	08600	477   IF(JJA.NE.4)GO TO 7515
24200	      	JRST  	E7515 
24300		SKIPN RJ6   ;	08700	      IF(RJ6.EQ.0)GO TO 7515
24500		JRST E7515
24600	;		08800	C  ABOVE FOR P1=6 (BEAMS, SLURS, LINES)
24700	;		08900	5515  RJ6=RJ6+R2
24900	E5515:	FADRM 	1,RJ6   
25000	;		09000	      IF(JJA.NE.6)GO TO 7515
25100		CAIE 6
25300	      	JRST  	E7515 
25400	;		09100	      IF(RJ9.EQ.0)GO TO 7515
25500	      	MOVE  	02,RJ9   
25600	      	JUMPE 	02,E7515 
25700	;		09200	      IF(RJ10.LT.30)GO TO 7515
25800	      	MOVSI 	02,205740
25900	      	CAMLE 	02,RJ10  
26000	      	JRST  	E7515 
26100	;		09300	      IF(JJA.EQ.6)RJ9=RJ9+R2
26200	      	CAIE 6
26400	      	JRST  .+3
26600	      	FADRM 	1,RJ9   
26800	;09400	 RJ9(P9) IS LOC. OF INNER NOTE IN BEAM RANGE. SKIPS NUMBERS IN P9.
26900	;		09500	7515  RJJ(1)=R2+RJJ(1)
27100	E7515:	FADRM 	1,RJJ   
27200		JRA 16,1(16) 	;	09600	      END
27300		END